home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 012a / lib194.zip / WINDOWS.PRG < prev   
Text File  |  1993-01-19  |  60KB  |  1,609 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: WINDOWS.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 06/19/1992
  5. *-- Notes.....: This set of functions was published in the JUNE, 1992 issue of
  6. *--             Technotes for dBASE IV (Vol. 90). The routines were created
  7. *--             by Adam Menkes, except for the ones added in (used by a couple
  8. *--             of the functions) that were written by Jay Parsons.
  9. *--             For a complete explanation on how these routines work, you need
  10. *--             to read the article in TechNotes. I have entered the routines,
  11. *--             and added the standard DUFLP notation at the beginning, and 
  12. *--             once this issue of TN has been posted on the BORBBS, this file
  13. *--             will be added to the 'current' version of LIBxx.ZIP.
  14. *-------------------------------------------------------------------------------
  15.  
  16. FUNCTION Alert
  17. *-------------------------------------------------------------------------------
  18. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  19. *-- Date........: 06/01/1992
  20. *--Notes.......: This routine creates a popup on the screen with a title and
  21. *--               one line message, forcing the user to notice the message.
  22. *--               The user must use the mouse on the 'OK' pad, press <Esc> or
  23. *--               press <Enter> to move on in the program that called this
  24. *--               function.
  25. *-- Written for.: dBASE IV, 1.5
  26. *-- Rev. History: 06/19/1992 - Modified to accept the <Enter> key by Ken Mayer,
  27. *--               also a bit better cleanup at the end (releasing things from
  28. *--               memory, and so on).
  29. *-- Calls.......: None
  30. *-- Called by...: Any
  31. *-- Usage.......: Alert("<cTitle>","<cMessage>")
  32. *-- Example.....: lX = Alert("Print Aborted","You pressed <ESC>")
  33. *-- Returns.....: Logical
  34. *-- Parameters..: cTitle   = Title line
  35. *--               cMessage = One line message (up to 79 characters)
  36. *-------------------------------------------------------------------------------
  37.  
  38.     parameters cTitle, cMessage
  39.     private wWindow,nRow,nCol,mPad
  40.     
  41.     wWindow = WINDOW()                  && save current Window
  42.     save screen to sTemp                && save the screen
  43.     activate screen
  44.     
  45.     nRow = iif(val(right(set("DISPLAY"),2)) = 43,18,8)  && center from top-bottom
  46.     nCol = 38 - (max(len(cTitle),len(cMessage))/2)      && center left-right
  47.     nCol2 = max(len(cTitle),len(cMessage))  && right side?
  48.     
  49.     *-- clear out a section of the screen
  50.     @nRow,nCol Clear to nRow+6,nCol+nCol2
  51.     *-- fill in a box
  52.     @nRow,nCol Fill  to nRow+6,nCol+nCol2+1 color n+  && grey
  53.     *-- put a double line border around box
  54.     @nRow,nCol to nRow+6,nCol+nCol2+1 double color bg+
  55.     *-- display title
  56.     @nRow + 1,nCol + 1 + iif(len(cTitle) > len(cMessage),0,;
  57.        (len(cMessage)-len(cTitle)) / 2) say cTitle color w+/n
  58.     *-- display line 
  59.     @nRow + 2, nCol + 1 to nRow + 2, nCol + nCol2 color bg+
  60.     *-- display message
  61.     @nRow + 3, nCol+1+iif(len(cTitle) > len(cMessage),;
  62.         (len(cTitle)-len(cMessage)) / 2, 0) say cMessage color w+/n
  63.     
  64.     *-- define/display a very small menu (one pad)
  65.     define menu mAlert
  66.     define pad pPad1 of mAlert prompt " OK " at nRow +5,37
  67.     on selection pad pPad1 of mAlert deactivate menu
  68.     
  69.     *-- added by Ken to deal with <Enter>
  70.     on key label ctrl-M keyboard "{27}"
  71.     
  72.     *-- start it up
  73.     activate menu mAlert
  74.     
  75.     *-- deal with user 'input'
  76.     mPad = pad()
  77.     
  78.     *-- restore environment, free up RAM by releasing things
  79.     on key label ctrl-m
  80.     restore screen from sTemp
  81.     release screen sTemp
  82.     release menu mAlert
  83.     if "" # wWindow
  84.         activate window &wWindow
  85.     endif
  86.     
  87. RETURN .not. "" = mPad  && not empty pad?
  88. *-- EoF: Alert()
  89.  
  90. FUNCTION CheckBox
  91. *-------------------------------------------------------------------------------
  92. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  93. *-- Date........: 06/01/1992
  94. *-- Notes.......: This routine brings up a one-line message, allows the user
  95. *--               to click mouse/press <Space> on it, to change status.
  96. *--               Pressing <Enter>/<Esc> chooses the current setting ...
  97. *-- Written for.: dBASE IV, 1.5
  98. *-- Rev. History: None
  99. *-- Calls.......: None
  100. *-- Called by...: Any
  101. *-- Usage.......: CheckBox(<lVar>,"<cTitle>",<nRow>,<nCol>,<nASCII>)
  102. *-- Example.....: lX = CheckBox(.t.,"OK as is?",9,10,4)
  103. *-- Returns.....: Logical
  104. *-- Parameters..: lVar     = On or Off to start? (.t.=on, .f.=off)
  105. *--               cTitle   = Title/Message
  106. *--               nRow     = Row to place this
  107. *--               nCol     = Column ...
  108. *--               nASCII   = ascii character to use in box. (Optional)
  109. *--                          Default is 251 (√). Other suggestions include:
  110. *--                          4 (diamond), 176 (░), 177 (▒), 178 (▓),
  111. *--                          219 (█), 249 (∙), 250 (·), 254 (■)
  112. *--                          (Check out the ASCII chart in the language ref.)
  113. *-------------------------------------------------------------------------------
  114.  
  115.     parameters lVar, cTitle, nRow, nCol, nASCII
  116.     
  117.     *-- if parameter is left blank, assign 251 (√)
  118.     nASCII = iif(pCount() = 5, nASCII, 251)
  119.     
  120.     define menu mCheck
  121.     
  122.     *-- loop until user does something, or presses <Esc>
  123.     do while .t.
  124.     
  125.         *-- define the menu pad ...
  126.         define pad pCheck1 of mCheck at nRow,nCol prompt;
  127.             "["+iif(lVar,chr(nASCII)," ")+"] "+cTitle
  128.         on selection pad pCheck1 of mCheck deactivate menu
  129.         
  130.         *-- when user presses <Enter> turn it all off ... (send <Esc> ...)
  131.         on key label ctrl-m keyboard "{27}"
  132.         
  133.         *-- start 'er up
  134.         activate menu mCheck
  135.         
  136.         *-- (<Esc> or <Enter>)
  137.         if lastkey() = 27
  138.             exit
  139.         endif
  140.         
  141.         lVar = .not. lVar   && set to opposite of current setting
  142.         
  143.     enddo
  144.     
  145.     *-- reset environment/release things
  146.     on key label ctrl-m
  147.     release menu mCheck
  148.  
  149. RETURN lVar
  150. *-- EoF: CheckBox()
  151.  
  152. Function CheckBx1
  153. *-------------------------------------------------------------------------------
  154. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  155. *-- Date........: 06/01/1992
  156. *-- Notes.......: This routine brings up a one-line message, allows the user
  157. *--               to click mouse/press <Space> on it, to change status.
  158. *--               Pressing <Enter>/<Esc> chooses the current setting ...
  159. *--               This one is different, in that it does not use a menu to
  160. *--               accomplish it's ends, but uses instead a memvar, with 
  161. *--               @/GET/READ and a picture using the multiple choice ("@M")
  162. *--               function.
  163. *-- Written for.: dBASE IV, 1.5
  164. *-- Rev. History: None
  165. *-- Calls.......: None
  166. *-- Called by...: Any
  167. *-- Usage.......: CheckBx1(<lVar>,"<cTitle>",<nRow>,<nCol>)
  168. *-- Example.....: lX = CheckBx1(.t.,"OK as is?",9,10)
  169. *-- Returns.....: Logical
  170. *-- Parameters..: lVar     = On or Off to start? (.t.=on, .f.=off)
  171. *--               cTitle   = Title/Message
  172. *--               nRow     = Row to place this
  173. *--               nCol     = Column ...
  174. *-------------------------------------------------------------------------------
  175.  
  176.     parameters lVar, cTitle, nRow, nCol
  177.     
  178.     *-- save parts of environment ...
  179.     cFormat = set("FORMAT")
  180.     set format to
  181.     cCursor = set("CURSOR")
  182.     set cursor off
  183.     
  184.     *-- define starting value of cVar ... 
  185.     *-- (this is ASCII 255, √, ASCII 255, if lVar = .t., 3 spaces if lVar = .f.)
  186.     cVar = iif(lVar,chr(255)+chr(251)+chr(255),space(3))
  187.     
  188.     *-- display/get, using picture
  189.     @nRow,nCol get cVar picture "@M , √ "
  190.     *-- this picture is: space, comma, chr(255), chr(251), chr(255).
  191.     @nRow,nCol + 4 say cTitle
  192.     
  193.     READ
  194.     
  195.     *-- reset environment
  196.     set format to &cFormat
  197.     set cursor &cCursor
  198.     
  199. RETURN .not. (cVar = chr(32))   && not a space
  200. *-- EoF: CheckBx1()
  201.  
  202. FUNCTION DropDown
  203. *-------------------------------------------------------------------------------
  204. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  205. *-- Date........: 06/01/1992
  206. *-- Notes.......: This function performs a picklist of a different sort.
  207. *--               In order to use it, you will either use an ARRAY (one-dim)
  208. *--               or a field in a database. It holds a choice in a 'holding 
  209. *--               area', allowing the user to leave it there, and maybe to 
  210. *--               change it with another option in the list.
  211. *--
  212. *--               I recommend you display an on-screen message for this one,
  213. *--               because it's not real intuitive (at least not to me).
  214. *--               To bring up the list, click on the arrows, to select an item,
  215. *--               click on the item, or highlight and press <enter>. To 
  216. *--               Change, click (or select) another item. To choose the actual
  217. *--               item you want, click on the one NEXT to the arrows (or use
  218. *--               the arrow keys to select that menu pad, and press <Enter>).
  219. *-- Written for.: dBASE IV, 1.5
  220. *-- Rev. History: None
  221. *-- Calls.......: TEMPNAME()           Function in WINDOWS.PRG
  222. *--               ARRAYROWS()          Function in WINDOWS.PRG
  223. *--               ARRAYCOLS()          Function in WINDOWS.PRG
  224. *--               FIELDNUM()           Function in WINDOWS.PRG
  225. *-- Called by...: Any
  226. *-- Usage.......: DropDown("<cType>","<cName>",[<nRow>,[<nCol>,[<nSize>]]])
  227. *-- Example.....: x=DropDown("F","Lastname",10,15,6)
  228. *--
  229. *--               Here is a suggested use:
  230. *--               @5,10 get cName when calldrop()  && function below
  231. *--               read
  232. *--               *-- do other stuff
  233. *--               FUNCTION CallDrop
  234. *--                 *-- display message about how to use
  235. *--                 @18,10 say "<Enter> or Click mouse on "+chr(23)+;
  236. *--                                                             " to see list"
  237. *--                 @19,10 say "<Enter> or Click mouse on name at top to select"
  238. *--                 *-- call it ... if using a FIELD in the database, you might
  239. *--                 *-- want to use a temp var, and then 
  240. *--                 *-- REPLACE <field> WITH ...
  241. *--                 cName = dropdown("F","NAME",6,10,5)  && call dropdown func.
  242. *--                 *-- redisplay it and clean out the 'gets' from memory
  243. *--                 @5,10 get cName
  244. *--                 clear gets
  245. *--                 keyboard chr(23)  && move on to next field ...
  246. *--               RETURN .T.
  247. *--
  248. *-- Returns.....: Selected item
  249. *-- Parameters..: cType  = 'F' = Field, 'A' = Array (1-Dimensional)
  250. *--               cName  = Field or Array name
  251. *--               nRow   = Coordinates to display menu
  252. *--               nCol   = Same  
  253. *--               nSize  = Number of items to display below dropdown box
  254. *-------------------------------------------------------------------------------
  255.  
  256.     parameters cType, cName, nRow, nCol, nSize
  257.     
  258.     *-- If these optional parms are NOT passed, we need to set default
  259.     *-- values ...
  260.     nSize = iif(pcount() <= 4, 5, nSize)
  261.     nCol  = iif(pCount() <= 3,10, nCol)
  262.     nRow  = iif(pCount() <= 2, 5, nRow)
  263.     
  264.     *-- setup
  265.     nMaxLen = 1
  266.     lNone = (set("BORDER") = "NONE")
  267.     define menu mDropDown
  268.     
  269.     *-- if it's an array, we work here for setup ...
  270.     if upper(cType) = "A"
  271.         nCols = arraycols(cName)
  272.         nRows = arrayrows(cName)
  273.         *-- determine width of display, by scanning each element of
  274.         *-- array and finding the largest ...
  275.         nX = 1
  276.         do while nX <= nCols
  277.             nMaxLen = Max(nMaxLen, len(&cName[nX]))
  278.             nX = nX + 1
  279.         enddo
  280.         
  281.         *-- here we're gonna define the popup part of it ...
  282.         define popup pDropDown from nRow+iif(lNone,0,1),;
  283.             nCol-iif(lNone,1,0) to nRow+nSize+;
  284.             iif(lNone,1,2),nCol+nMaxLen+iif(lNone,0,1)
  285.         *-- define the bars ... the loops have to be done seperate,
  286.         *-- since the width must be determined before the bars are defined.
  287.         nX = 1
  288.         do while nX <= nCols
  289.             define bar nX of DropDown prompt &cName[nX]
  290.             nX = nX + 1
  291.         enddo
  292.         
  293.     else
  294.         *-- process if it's a field here
  295.         do case
  296.             case type ("&cName") = "C"  && character
  297.                 calculate max(len(trim(&cName))) to nMaxLen
  298.             case type ("&cName") $ "FN" && numeric (or floating)
  299.                 cAlias = alias()
  300.                 dbftemp = tempname("DBF")
  301.                 nNum = fieldnum(cName)
  302.                 copy structure extended to (dbfTemp)
  303.                 select select()
  304.                 use (dbftemp) exclusive nosave
  305.                 go nNum
  306.                 nMaxLen = field_Len
  307.                 use
  308.                 select (cAlias)
  309.             case type ("&cName") = "D"
  310.                 nMaxLen = iif(set("CENTURY") = "ON",10,8)
  311.             case type ("&cName") = "L"
  312.                 nMaxLen = 1
  313.             endcase
  314.             define popup pDropdown from nRow + iif(lNone,0,1),nCol-;
  315.                 iif(lNone,1,0) to nRow+nSize+iif(lNone,1,2),;
  316.                 nCol+nMaxLen+iif(lNone,0,1) prompt field &cName
  317.         endif
  318.         
  319.         *-- define the pad that activates this thing ...
  320.         define pad pPad2 of mDropDown prompt chr(23) at nRow,nCol+nMaxLen
  321.         on selection pad pPad2 of mDropDown activate popup pDropDown
  322.         on selection popup pDropDown deactivate menu
  323.         
  324.         do while lastkey() # 27
  325.             xPrompt = trim(prompt())+space(nMaxLen - len(trim(prompt())))
  326.             define pad pPad1 of mDropDown prompt xPrompt at nRow,nCol
  327.             on selection pad pPad1 of mDropDown deactivate menu
  328.             activate menu mDropDown pad pPad2
  329.             if pad() = "PPAD1"
  330.                 exit
  331.             endif
  332.         enddo
  333.         
  334.         release popup pDropDown
  335.         release menu mDropDown
  336.         
  337. RETURN trim(prompt())
  338. *-- EoF: DropDown()
  339.  
  340. FUNCTION MsWind
  341. *-------------------------------------------------------------------------------
  342. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  343. *-- Date........: 06/01/1992
  344. *-- Notes.......: This one creates a window that acts like one from WINDOWS,
  345. *--               in that you can move it, enlarge it to full-screen, and
  346. *--               bring it back to its original size.
  347. *-- Written for.: dBASE IV, 1.5
  348. *-- Rev. History: None
  349. *-- Calls.......: MOVEWINU             Procedure in WINDOWS.PRG
  350. *--               MOVEWIND             Procedure in WINDOWS.PRG
  351. *--               ENLARGE              Procedure in WINDOWS.PRG
  352. *--               MSWINACT             Procedure in WINDOWS.PRG
  353. *-- Called by...: Any
  354. *-- Usage.......: MsWind(<nTop>,<nLeft>,<nLower>,<nRight>)
  355. *-- Example.....: x=MsWind(5,10,20,70)
  356. *-- Returns.....: Logical
  357. *-- Parameters..: nTop    = Top Row of window
  358. *--               nLeft   = Left column
  359. *--               nBottom = Bottom Row of Window
  360. *--               nRight  = Right column
  361. *-------------------------------------------------------------------------------
  362.  
  363.     parameters nTop, nLeft, nLower, nRight
  364.     
  365.     *-- save environment
  366.     save screen to sMSWIND
  367.     lStatus = (set("STATUS") = "ON")
  368.     lDisp43 = ("43" $ SET("DISPLAY"))
  369.     
  370.     *-- loop
  371.     do while .t.
  372.         restore screen from sMSWIND
  373.         
  374.         *-- define/redefine window area and box
  375.         @nTop, nLeft clear to nLower, nRight
  376.         @nTop, nLeft TO nLower, nRight
  377.         
  378.         *-- using menus to simulate Windows window ...
  379.         define menu wNormal
  380.         define pad pCabinet of wNormal prompt "["+chr(254)+"]";
  381.             at nTop, nLeft + 1           && ■
  382.         define pad pMoveUp  of wNormal prompt chr(18) ;
  383.             at nTop, nRight - 4          && up/down-arrow
  384.         define pad pEnlarge of wNormal prompt chr(30) ;
  385.             at nTop, nRight - 1          && up-arrow-head
  386.         define pad pMoveDn  of wNormal prompt chr(18) ;
  387.             at nLower, nRight - 4        && up/down arrow again
  388.         
  389.         *-- tell it what to do when an item is selected
  390.         on selection pad pCabinet of wNormal deactivate menu
  391.         on selection pad pMoveUp  of wNormal do movewinu
  392.         on selection pad pEnlarge of wNormal do enlarge
  393.         on selection pad pMoveDn  of wNormal do movewind
  394.         
  395.         *-- deal with changes ...
  396.         do mswinact with nTop, nLeft
  397.         activate menu wnormal
  398.         *-- User pressed <Esc> or chose the 'close window' button/pad
  399.         if lastkey() = 27 .or. "PCABINET" = pad()
  400.             exit
  401.         endif
  402.     
  403.     enddo  && end of loop
  404.     
  405.     *-- restore environment
  406.     restore screen from sMSWIND
  407.     release screen sMSWIND
  408.     release menu wNormal
  409.  
  410. RETURN .not. "" = pad()
  411. *-- EoF: MSWind()
  412.  
  413. PROCEDURE Enlarge
  414. *-------------------------------------------------------------------------------
  415. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  416. *-- Date........: 06/01/1992
  417. *-- Notes.......: Used in MSWIND() to 'enlarge' the a window, and redfine
  418. *--               the menu ...
  419. *-- Written for.: dBASE IV, 1.5
  420. *-- Rev. History: None
  421. *-- Calls.......: MsWinAct             Procedure in WINDOWS.PRG
  422. *-- Called by...: MsWind()             Function in WINDOWS.PRG
  423. *-- Usage.......: Do Enlarge
  424. *-- Example.....: Do Enlarge
  425. *-- Returns.....: None
  426. *-- Parameters..: None
  427. *-------------------------------------------------------------------------------
  428.     
  429.     *-- clear screen, draw border from upper left to a bottom right corner ...
  430.     clear
  431.     @0,0 to iif(lStatus,21,24) + iif(lDisp43,18,0), 79
  432.     
  433.     *-- define new version of menu
  434.     define menu mEnlarge
  435.     define pad pCabinet of mEnlarge prompt "["+chr(254)+"]" at 0,2
  436.     define pad pReduce  of mEnlarge prompt chr(31) at 0,78
  437.     on selection pad pCabinet of mEnlarge deactivate menu
  438.     on selection pad pReduce  of mEnlarge deactivate menu
  439.     
  440.     *-- Routine to allow interaction inside menu window ...
  441.     do mswinact with 0,0
  442.  
  443.     *-- start 'er up
  444.     activate menu mEnlarge
  445.     deactivate menu
  446.     if lastkey() = 27
  447.         keyboard "{27}"
  448.     endif
  449.     release menu mEnlarge
  450.     clear
  451.  
  452. RETURN
  453. *-- EoP: Enlarge
  454.  
  455. PROCEDURE MoveWinU
  456. *-------------------------------------------------------------------------------
  457. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  458. *-- Date........: 06/01/1992
  459. *-- Notes.......: Used in MSWIND() to move the window up (unless the
  460. *--               window is at the top of the screen ...)
  461. *-- Written for.: dBASE IV, 1.5
  462. *-- Rev. History: None
  463. *-- Calls.......: None
  464. *-- Called by...: MsWind()             Function in WINDOWS.PRG
  465. *-- Usage.......: Do MoveWinU
  466. *-- Example.....: Do MoveWinU
  467. *-- Returns.....: None
  468. *-- Parameters..: None
  469. *-------------------------------------------------------------------------------
  470.     
  471.     *-- check for top of screen ... change coordinates
  472.     nTop = nTop - iif(nTop = 0,0,1)
  473.     nLower = nLower - iif(nTop = 0,0,1)
  474.     deactivate menu
  475.  
  476. RETURN
  477. *-- EoP: MoveWinU
  478.  
  479. PROCEDURE MoveWinD
  480. *-------------------------------------------------------------------------------
  481. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  482. *-- Date........: 06/01/1992
  483. *-- Notes.......: Used in MSWIND() to move the window down (unless the
  484. *--               window is at the bottom of the screen ...)
  485. *-- Written for.: dBASE IV, 1.5
  486. *-- Rev. History: None
  487. *-- Calls.......: None
  488. *-- Called by...: MsWind()             Function in WINDOWS.PRG
  489. *-- Usage.......: Do MoveWinD
  490. *-- Example.....: Do MoveWinD
  491. *-- Returns.....: None
  492. *-- Parameters..: None
  493. *-------------------------------------------------------------------------------
  494.     
  495.     *-- check for bottom of screen/status line ... change coordinates
  496.     nTop = nTop + iif(nLower = iif(lStatus,21,24)+;
  497.         iif(lDisp43,18,0),0,1)
  498.     nLower = nLower + iif(nLower=iif(lStatus,21,24)+;
  499.         iif(lDisp43,18,0),0,1)
  500.     deactivate menu
  501.  
  502. RETURN
  503. *-- EoP: MoveWinD
  504.  
  505. PROCEDURE MSWinAct
  506. *-------------------------------------------------------------------------------
  507. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  508. *-- Date........: 06/01/1992
  509. *-- Notes.......: Used in MSWIND() to move the actually display/redisplay 
  510. *--               information inside the window, even when a window has been
  511. *--               moved. This routine should be modified for a specific
  512. *--               system ... 
  513. *-- Written for.: dBASE IV, 1.5
  514. *-- Rev. History: None
  515. *-- Calls.......: None
  516. *-- Called by...: MsWind()             Function in WINDOWS.PRG
  517. *-- Usage.......: Do MSWinAct with <nTop>, <nLeft>
  518. *-- Example.....: Do MSWinAct with 5,10
  519. *-- Returns.....: None
  520. *-- Parameters..: None
  521. *-------------------------------------------------------------------------------
  522.     
  523.     parameters nTop, nLeft
  524.     private nTop, nLeft
  525.     
  526.     @nTop + 2, nLeft + 2 say "This is line 1"
  527.     @nTop + 3, nLeft + 2 say "And this is line 2"
  528.     
  529. RETURN
  530. *-- EoP: MSWinAct
  531.  
  532. FUNCTION RadioBut
  533. *-------------------------------------------------------------------------------
  534. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  535. *-- Date........: 06/01/1992
  536. *-- Notes.......: This is a Radio Button routine.  NOTE that the array called as
  537. *--               cArray below must be a character array (i.e., all data must
  538. *--               be character data ...).
  539. *-- Written for.: dBASE IV, 1.5
  540. *-- Rev. History: None
  541. *-- Calls.......: ArrayCols()          Function in WINDOWS.PRG
  542. *--               TmpRadio             Procedure in WINDOWS.PRG
  543. *-- Called by...: None
  544. *-- Usage.......: RadioBut("<cArray>",<nRow>,<nCol>,<nDefPad>,<nASCII>)
  545. *-- Example.....: nReturn =  RadioBut("aTest",5,10,1,15)
  546. *-- Returns.....: Numeric (Array Index of item selected)
  547. *-- Parameters..: cArray  = Name of Array (Charater data)
  548. *--               nRow    = Row for coordinates ... (start position)
  549. *--               nCol    = Column for same
  550. *--               nDefPad = Default Pad number
  551. *--               nASCII  = ASCII character to use as 'button' (Optional ...)
  552. *--                   try: 4 (Diamond), 9 (Circle), 15 (splot), 42 (*), 249 (∙), 
  553. *--                        251 (√) or 254 (■) ...
  554. *-------------------------------------------------------------------------------
  555.     
  556.     parameters cArray, nRow, nCol, nDefPad, nASCII
  557.     
  558.     define menu mRadio
  559.     public aTmpRadio, nARows, nPad
  560.     
  561.     *-- get number of items to display
  562.     nARows = ArrayRows(cArray)
  563.     
  564.     *-- set character for 'button'
  565.     nASCII = iif(PCOUNT() <= 4,4,nASCII) && default is a 'diamond'
  566.     
  567.     *-- start definitions ...
  568.     cPad = iif(pcount() => 4 .and. nDefPad # 0, ltrim(str(nDefPad)),"1")
  569.     nCol = iif(pcount() <= 2,10,nCol)
  570.     nRow = iif(pCount() <= 1,5,nRow)
  571.     
  572.     *-- here we get the largest item in the array ...
  573.     nX = 1
  574.     nLongest = 1
  575.     do while nX <= nARows
  576.         nLongest = max(nLongest,len(trim(&cArray[nX])))
  577.         nX = nX + 1
  578.     enddo
  579.     
  580.     *-- define a temporary array ...
  581.     declare aTmpRadio[nARows]
  582.     
  583.     on key label ctrl-m keyboard "{27}"  && close down if <Enter> ...
  584.     
  585.     cX = "1"
  586.     do while .t.
  587.         
  588.         *-- define menu pads
  589.         do while val(cX) <= nARows
  590.             define pad button&cX of mRadio at nRow - 1 + val(cX),nCol;
  591.                 prompt "("+ iif(aTmpRadio[val(cX)] .or. cPad = cX,;
  592.                 chr(nASCII)," ")+") "+trim(&cArray[val(cX)])+;
  593.                 space(nLongest-len(trim(&cArray[val(cX)])))
  594.             on selection pad button&cX of mRadio deactivate menu
  595.             cX = ltrim(str(val(cX)+1))
  596.         enddo
  597.     
  598.         *-- start 'er up
  599.         activate menu mRadio pad button&nPad
  600.         *-- if <Esc> (or <Enter>), we're done ...
  601.         if lastkey() = 27
  602.             nPad = substr(pad(),7)
  603.             exit
  604.         else
  605.             *-- if not, perform routine below to reset the temp array ...
  606.             do TmpRadio
  607.         endif
  608.     enddo
  609.     
  610.     *-- cleanup
  611.     on key label ctrl-m
  612.     ny = 1
  613.     do while ny <= nARows .and. .not. aTmpRadio[nY]
  614.         nY = nY + 1
  615.     enddo
  616.     release aTmpRadio, nPad
  617.     release menu mRadio
  618.  
  619. RETURN iif(nY > nARows, 0, nY)
  620. *-- EoF: RadioBut()
  621.  
  622. PROCEDURE TmpRadio
  623. *-------------------------------------------------------------------------------
  624. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  625. *-- Date........: 06/01/1992
  626. *-- Notes.......: Used to set/reset the temporary array aTmpRadio[] for use
  627. *--               in the RadioBut() function above.
  628. *-- Written for.: dBASE IV, 1.5
  629. *-- Rev. History: None
  630. *-- Calls.......: None
  631. *-- Called by...: RadioBut()           Function in WINDOWS.PRG
  632. *-- Usage.......: Do TmpRadio
  633. *-- Example.....: Do TmpRadio
  634. *-- Returns.....: None
  635. *-- Parameters..: None
  636. *-------------------------------------------------------------------------------
  637.     
  638.     nPad = substr(pad(),7)
  639.     nY = 1
  640.     do while nY <= nARows
  641.         aTmpRadio[nY] = .f.
  642.         nY = nY + 1
  643.     enddo
  644.     aTmpRadio[val(nPad)] = .t.
  645.     cX = "1"
  646.  
  647. RETURN
  648. *-- EoP: TmpRadio
  649.  
  650. FUNCTION ScrolBar
  651. *-------------------------------------------------------------------------------
  652. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  653. *-- Date........: 06/01/1992
  654. *-- Notes.......: Performs a horizontal scroll-bar to find a record in a 
  655. *--               database file. Note that this function assumes a database 
  656. *--               is open. Not quite sure how I'd use this one ...
  657. *-- Written for.: dBASE IV, 1.5
  658. *-- Rev. History: None
  659. *-- Calls.......: None
  660. *-- Called by...: None
  661. *-- Usage.......: ScrolBar(<nAtLine>)
  662. *-- Example.....: This example is from the text of Adam's article:
  663. *--               Add the following line to your program or FMT file:
  664. *--
  665. *--               ON KEY LABEL F5 DO MoveRec
  666. *--
  667. *--               Create a simple PROCEDURE or program with the following:
  668. *--
  669. *--               PROCEDURE MoveRec
  670. *--                 on key label ctrl-M chr(27) && press <Enter> to return
  671. *--                 x=scrolbar(20)              && call function
  672. *--                 on key label ctrl-M         && reset CTRL-M key
  673. *--               RETURN
  674. *--
  675. *-- Returns.....: .T.
  676. *-- Parameters..: nAtLine = Line of screen (ROW) to display scroll bar at.
  677. *-------------------------------------------------------------------------------
  678.     
  679.     parameters nAtLine
  680.     nAtLine = iif(pCount() = 1, nAtLine, 20)
  681.     nBreak = 76
  682.     cx = "1"
  683.     ny = 1
  684.     nRecord = reccount()
  685.     nZ = (nBreak/nRecord) - int(nBreak/nRecord)
  686.     
  687.     *-- once again, this is being done via a menu ...
  688.     define menu mScrollBar 
  689.     define pad pPad0 of mScrollBar prompt chr(17) at nAtLine, 1
  690.     *-- if the first pad is selected, back up one record
  691.     on selection pad pPad0 of mScrollBar skip iif(bof(),0,-1)
  692.     
  693.     *-- deal with location of the rest ...
  694.     do while val(cX) <= nRecord
  695.         if nRecord <= nBreak
  696.             define pad pPad&cX of mScrollBar ;
  697.                 prompt;
  698.                 space((nBreak/nRecord)+iif(nZ => 1, int(nZ),0)) at nAtLine, nY + 1
  699.         endif
  700.         nY = nY + int(nBreak/nRecord)+iif(nZ => 1, int(nZ),0)
  701.         if nZ => 1
  702.             nZ = nZ - int(nZ)
  703.         endif
  704.         
  705.         nZ = nZ + (nBreak / nRecord) - int(nBreak/nRecord)
  706.         on selection pad pPad&cX of mScrollBar go val(substr(pad(),4))
  707.         cX = ltrim(str(val(cX) + 1))
  708.     enddo
  709.     
  710.     *-- define final pad
  711.     define pad pPad&cX of mScrollBar prompt chr(16) at nAtLine, nY + 1
  712.     on selection pad pPad&cX of mScrollBar skip iif(eof(),0,1)
  713.     
  714.     *-- start 'er up ...
  715.     activate menu mScrollBar
  716.  
  717. RETURN .t.
  718. *-- EoF: ScrolBar()
  719.  
  720. *-------------------------------------------------------------------------------
  721. *-- This section is where I, Ken Mayer, attempted to modify/improve some of
  722. *-- Adam's routines ... I may or may not have been successful, YOU decide ...
  723. *-- <g>
  724. *-------------------------------------------------------------------------------
  725.  
  726. FUNCTION Alert2
  727. *-------------------------------------------------------------------------------
  728. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  729. *-- Date........: 06/01/1992
  730. *-- Notes.......: This routine creates a popup on the screen with a title and
  731. *--               one line message, forcing the user to notice the message.
  732. *--               The user must use the mouse on the 'OK' pad, press <Esc> or
  733. *--               press <Enter> to move on in the program that called this
  734. *--               function.
  735. *-- Written for.: dBASE IV, 1.5
  736. *-- Rev. History: Modified to accept the <Enter> key by Ken Mayer.
  737. *--               06/19/1992 -- Copied from Adam's original, uses a window,
  738. *--                 shadow, and programmer defineable colors.
  739. *--               07/29/1992 -- Joey stepped in and made some modifications
  740. *--                 that seem to have helped as well, including dealing with
  741. *--                 the keyboard buffer.
  742. *--               10/09/1992 -- minor change -- title is now same color as
  743. *--                 the "pad".
  744. *--               11/09/1992 -- Joey Carroll added some minor changes for
  745. *--                 cosmetics, as well as keeping the colors working
  746. *--                 properly.
  747. *-- Calls.......: SHADOW               Procedure in PROC.PRG
  748. *--               CENTER               Procedure in PROC.PRG
  749. *--               JUSTIFY()            Function in WINDOWS.PRG
  750. *-- Called by...: Any
  751. *-- Usage.......: Alert2("<cTitle>","<cMessage>","<cColor>")
  752. *-- Example.....: lX = Alert2("Print Aborted","You pressed <ESC>",;
  753. *--                           "rg+/r,w+/b,rg+/r")
  754. *-- Returns.....: Logical
  755. *-- Parameters..: cTitle   = Title line
  756. *--               cMessage = One line message (up to 75 characters)
  757. *--               cColor   = Colors: <window forg/back>,<pad> (and title),<box>
  758. *-------------------------------------------------------------------------------
  759.  
  760.     parameters cTitle, cMessage, cColor
  761.     private wWindow,nRow,nCol,mPad,cTempCol
  762.     
  763.     wWindow = WINDOW()                  && save current Window
  764.     save screen to sTemp                && save the screen
  765.    i=inkey() && clear out keyboard buffer
  766.     
  767.     *-- get window coordinates
  768.     *-- this centers from top to bottom, depending on monitor setup ...
  769.     nULRow = iif(val(right(set("DISPLAY"),2)) = 43,18,8)
  770.     *-- add 6, so the Window is large enough ...
  771.     nBRRow = nULRow + 6
  772.     *-- left column ...
  773.     nULCol = 36 - (max(len(cTitle),len(cMessage))/2)    && center left-right
  774.     *-- right column ...
  775.     nBRCol = nULCol + max(len(cTitle),len(cMessage))+4  && right side?
  776.     *-- Window width ...
  777.     nWidth = nBRCol - nULCol - 1
  778.     
  779.     *-- define window
  780.    Define window wAlert from nULRow,nULCol to nBRRow,nBRCol DOUBLE ;
  781.             color &cColor.
  782.     activate screen
  783.     *-- display shadow
  784.     do shadow with nULRow,nULCol,nBRRow,nBRCol
  785.     
  786.     *-- start 'er up ...
  787.     activate window wAlert
  788.     
  789.     *-- display title
  790.     cTempCol = colorbrk(cColor,2)
  791.     if len(cTitle) < nWidth
  792.         cTitle = justify(cTitle,nWidth,"C")
  793.         if len(cTitle) < nWidth
  794.             cTitle = cTitle + " "
  795.         endif
  796.     endif
  797.     do center with 0,nWidth,"&cTempCol",cTitle
  798.     
  799.     *-- display line 
  800.     cTempCol = colorbrk(cColor,1)
  801.     @1,0 say replicate(chr(196),nWidth) color &cTempCol
  802.     
  803.     *-- display message
  804.     do center with 2,nWidth,"",cMessage
  805.     
  806.     *-- define/display a very small menu (one pad)
  807.     define menu mAlert
  808.     define pad pPad1 of mAlert prompt "[OK]" at 4,(nWidth/2)-1
  809.     on selection pad pPad1 of mAlert deactivate menu
  810.     
  811.     *-- added by Ken to deal with <Enter>
  812.     on key label ctrl-M keyboard "{27}"
  813.     
  814.     *-- start it up
  815.     activate menu mAlert
  816.     
  817.     *-- deal with user 'input'
  818.     mPad = pad()
  819.     deactivate window wAlert
  820.     release window wAlert
  821.     
  822.     *-- restore environment, free up RAM by releasing things
  823.     on key label ctrl-m
  824.     restore screen from sTemp
  825.     release screen sTemp
  826.     release menu mAlert
  827.     if "" # wWindow
  828.         activate window &wWindow
  829.     endif
  830.     
  831. RETURN .not. "" = mPad  && not empty pad?
  832. *-- EoF: Alert2()
  833.  
  834. FUNCTION MsWind2
  835. *-------------------------------------------------------------------------------
  836. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  837. *-- Date........: 06/01/1992
  838. *-- Notes.......: This one creates a window that acts like one from WINDOWS,
  839. *--               in that you can move it, enlarge it to full-screen, and
  840. *--               bring it back to its original size.
  841. *--               NOTE: The Title is NOT displaying in the EXPANDED Window.
  842. *--               This is based on a KNOWN BUG, forwarded to development.
  843. *-- Written for.: dBASE IV, 1.5
  844. *-- Rev. History: 06/23/1992 -- Ken Mayer -- Attempts made to use a 'real'
  845. *--               window (a dBASE defined window), shadows, colors, and make
  846. *--               the window look more like a Microsoft Windows Window.
  847. *-- Calls.......: MOVEWIN2             Procedure in WINDOWS.PRG
  848. *--               ENLARGE2             Procedure in WINDOWS.PRG
  849. *--               MSWINAC2             Procedure in WINDOWS.PRG
  850. *--               SHADOW               Procedure in PROC.PRG
  851. *-- Called by...: Any
  852. *-- Usage.......: MsWind2(<nTop>,<nLeft>,<nLower>,<nRight>,"<cColor>",;
  853. *--                      "<cTitle>")
  854. *-- Example.....: x=MsWind2(5,10,20,70,"rg+/gb,w+/b,rg+/gb","This is a title")
  855. *-- Returns.....: Logical
  856. *-- Parameters..: nTop    = Top Row of window
  857. *--               nLeft   = Left column
  858. *--               nBottom = Bottom Row of Window
  859. *--               nRight  = Right column
  860. *--               cColor  = Color combinations to be used:
  861. *--                         <Normal/Unselected pad>,<Selected pad>,<Box>
  862. *--               cTitle  = Title for first line of window ... 
  863. *--                         NOTE: if the title is longer than can be displayed
  864. *--                         with the buttons on the first line, it will be
  865. *--                         truncated ...
  866. *-------------------------------------------------------------------------------
  867.  
  868.     parameters nTop, nLeft, nLower, nRight, cColor, cTitle
  869.     
  870.     *-- save environment
  871.     save screen to sMSWIND
  872.     lStatus = (set("STATUS") = "ON")
  873.     lDisp43 = ("43" $ SET("DISPLAY"))
  874.     cMSColor = set("ATTRIBUTES")
  875.     
  876.     *-- loop
  877.     do while .t.
  878.         
  879.         *-- bring back old screen before defining all this
  880.         if window() = "WMSWIND"
  881.             deactivate window wMSWIND
  882.         endif
  883.         restore screen from sMSWIND
  884.         
  885.         *-- define/redefine window area and box
  886.         activate screen
  887.         define window wMSWind from nTop,nLeft to nLower,nRight double;
  888.             color &cColor
  889.         do shadow with nTop,nLeft,nLower,nRight
  890.         activate window wMSWind
  891.         
  892.         *-- deal with defining where to display the title (and truncating
  893.         *-- if necessary)
  894.         *-- define width and height of window
  895.         nWidth = nRight - nLeft - 2  && account for border
  896.         nHeight = nLower - nTop - 2  && ditto
  897.         
  898.         nWidth2 = nWidth - 9 && (space used by menu buttons)
  899.         if len(trim(cTitle)) > (nWidth2 - 2) && leave room for a space on each sd
  900.             cTitle2 = left(cTitle,nWidth2-2)
  901.         else
  902.             cTitle2 = trim(cTitle)
  903.         endif
  904.         nSpaces = nWidth2 - len(cTitle2)
  905.         nSpaces1 = nSpaces/2
  906.         nSpaces2 = iif(nSpaces1=int(nSpaces/2),nSpaces1,nSpaces1+1)
  907.         cTitle2 = space(nSpaces1) + cTitle2 + space(nSpaces2)
  908.         cTitlCol = colorbrk(cColor,2)
  909.         @0,3 say cTitle2 color &cTitlCol
  910.         
  911.         *-- using menus to simulate Windows window ...
  912.         define menu wNormal
  913.         define pad pCabinet of wNormal prompt "["+chr(254)+"]" at 0, 0
  914.         define pad pMoveUp  of wNormal prompt "["+chr(24)+"]"  at 0,nWidth - 6
  915.         define pad pEnlarge of wNormal prompt "["+chr(30)+"]" at 0,nWidth - 3
  916.         define pad pMoveDn  of wNormal prompt "["+chr(25)+"]" ;
  917.             at nHeight, nWidth - 3
  918.         define pad pMoveRt  of wNormal prompt "["+chr(26)+"]" ;
  919.             at nHeight, nWidth - 6
  920.         define pad pMoveLf  of wNormal prompt "["+chr(27)+"]" ;
  921.             at nHeight, nWidth - 9
  922.         
  923.         *-- tell it what to do when an item is selected
  924.         on selection pad pCabinet of wNormal deactivate menu
  925.         on selection pad pMoveUp  of wNormal do movewin with pad()
  926.         on selection pad pEnlarge of wNormal do enlarge2 with cTitle, cTitlCol
  927.         on selection pad pMoveDn  of wNormal do movewin with pad()
  928.         on selection pad pMoveRt  of wNormal do movewin with pad()
  929.         on selection pad pMoveLf  of wNormal do movewin with pad()
  930.         
  931.         *-- Display something in Window
  932.         do mswinat2
  933.         
  934.         *-- start the menu
  935.         activate menu wnormal
  936.         
  937.         *-- User pressed <Esc> or chose the 'close window' button/pad
  938.         if lastkey() = 27 .or. "PCABINET" = pad()
  939.             exit
  940.         endif
  941.         
  942.     enddo  && end of loop
  943.     
  944.     *-- restore environment
  945.     deactivate window wMSWind
  946.     release window wMSWind
  947.     restore screen from sMSWIND
  948.     release screen sMSWIND
  949.     release menu wNormal
  950.     
  951. RETURN .not. "" = pad()
  952. *-- EoF: MSWind()
  953.  
  954. PROCEDURE Enlarge2
  955. *-------------------------------------------------------------------------------
  956. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  957. *-- Date........: 06/01/1992
  958. *-- Notes.......: Used in MSWIND() to 'enlarge' the a window, and redfine
  959. *--               the menu ...
  960. *-- Written for.: dBASE IV, 1.5
  961. *-- Rev. History: 06/23/1992 -- Ken Mayer (CIS: 71333,1030) - redefined to handle
  962. *--                using real dBASE Windows ...
  963. *-- Calls.......: MsWinAt2             Procedure in WINDOWS.PRG
  964. *-- Called by...: MsWind2()            Function in WINDOWS.PRG
  965. *-- Usage.......: Do Enlarge2 with cTitle, cTitlCol
  966. *-- Example.....: Do Enlarge2 with cTitle, cTitlCol
  967. *-- Returns.....: None
  968. *-- Parameters..: cTitle   = Title from MSWIND2()
  969. *--               cTitlCol = Title color (also from MSWIND2())
  970. *-------------------------------------------------------------------------------
  971.     
  972.     parameters cTitle, cTitlCol
  973.     
  974.     *-- do a new version of the window ...
  975.     deactivate window wMSWind
  976.     restore screen from sMSWIND
  977.     activate screen
  978.     define window wMSWind from 0,0 to iif(lStatus,20,23) + iif(lDisp43,18,0), 77;
  979.         double color &cColor
  980.     do shadow with 0,0,iif(lstatus,20,23)+iif(lDisp43,18,0),77
  981.     activate window wMSWind
  982.     
  983.     *-- deal with TITLE ...
  984.     *-- deal with defining where to display the title (and truncating
  985.     *-- if necessary)
  986.     *-- define width and height of window
  987.     nWidth = 74 && account for border
  988.     nWidth2 = nWidth - 6 && (space used by menu buttons)
  989.     if len(trim(cTitle)) > (nWidth2 - 2) && leave room for a space on each side
  990.         cTitle2 = left(cTitle,nWidth2-2)
  991.     else
  992.         cTitle2 = trim(cTitle)
  993.     endif
  994.     nSpaces = nWidth2 - len(cTitle2)
  995.     nSpaces1 = nSpaces/2
  996.     nSpaces2 = iif(nSpaces1=int(nSpaces/2),nSpaces1,nSpaces1+1)
  997.     cTitle2 = space(nSpaces1) + cTitle2 + space(nSpaces2)
  998.     @0,3 say cTitle2 color &cTitlCol
  999.     
  1000.     *-- define new version of menu
  1001.     define menu mEnlarge
  1002.     define pad pCabinet of mEnlarge prompt "["+chr(254)+"]" at 0,0
  1003.     define pad pReduce  of mEnlarge prompt "["+chr(31)+"]"  at 0,72
  1004.     on selection pad pCabinet of mEnlarge deactivate menu
  1005.     on selection pad pReduce  of mEnlarge deactivate menu
  1006.     
  1007.     *-- Routine to allow interaction inside menu window ...
  1008.     do mswinat2
  1009.     
  1010.     *-- start 'er up
  1011.     activate menu mEnlarge
  1012.     if lastkey() = 27
  1013.         keyboard "{27}"
  1014.     endif
  1015.     deactivate menu
  1016.     deactivate window wMSWIND
  1017.     release window wMSWIND
  1018.     release menu mEnlarge
  1019.  
  1020. RETURN
  1021. *-- EoP: Enlarge2
  1022.  
  1023. PROCEDURE MoveWin
  1024. *-------------------------------------------------------------------------------
  1025. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  1026. *-- Date........: 06/23/1992
  1027. *-- Notes.......: Used in MSWIND() to move the window up (unless the
  1028. *--               window is at the top of the screen ...)
  1029. *-- Written for.: dBASE IV, 1.5
  1030. *-- Rev. History: None
  1031. *-- Calls.......: None
  1032. *-- Called by...: MsWind()             Function in WINDOWS.PRG
  1033. *-- Usage.......: Do MoveWin with <pPad> 
  1034. *-- Example.....: Do MoveWin with pad()
  1035. *-- Returns.....: None
  1036. *-- Parameters..: pPad = menu pad selected to move window ...
  1037. *-------------------------------------------------------------------------------
  1038.     
  1039.     parameters pPad
  1040.     
  1041.     restore screen from sMSWIND
  1042.     
  1043.     do case
  1044.         case pPad = "PMOVEUP"
  1045.             
  1046.             *-- check for top of screen ... change coordinates
  1047.             nTop = nTop - iif(nTop = 0,0,1)
  1048.             nLower = nLower - iif(nTop = 0,0,1)
  1049.             
  1050.         case pPad = "PMOVEDN"
  1051.         
  1052.             nTop = nTop + iif(nLower = iif(lStatus,21,24)+;
  1053.                 iif(lDisp43,18,0),0,1)
  1054.             nLower = nLower + iif(nLower=iif(lStatus,21,24)+;
  1055.                 iif(lDisp43,18,0),0,1)
  1056.             
  1057.         case pPad = "PMOVELF"
  1058.         
  1059.             nLeft = nLeft - iif(nLeft = 0,0,1)
  1060.             nRight = nRight - iif(nLeft = 0,0,1)
  1061.             
  1062.         case pPad = "PMOVERT"
  1063.             
  1064.             nRight = nRight + iif(nRight = 79,0,1)
  1065.             nLeft = nLeft + iif(nRight = 79,0,1)
  1066.             
  1067.     endcase
  1068.     deactivate menu
  1069.     
  1070. RETURN
  1071. *-- EoP: MoveWin
  1072.  
  1073. PROCEDURE MSWinAt2
  1074. *-------------------------------------------------------------------------------
  1075. *-- Programmer..: Adam L. Menkes (BORLAND TECHNICAL SUPPORT)
  1076. *-- Date........: 06/01/1992
  1077. *-- Notes.......: Used in MSWIND2() to move the actually display/redisplay 
  1078. *--               information inside the window, even when a window has been
  1079. *--               moved. This routine should be modified for a specific
  1080. *--               system ...  This version (for MSWIND2()) starts counting
  1081. *--               at the top + 1 -- the first line (0) is for the menu and
  1082. *--               the title ...
  1083. *-- Written for.: dBASE IV, 1.5
  1084. *-- Rev. History: 06/23/1992 -- Modified by Ken Mayer to work with MSWIND2().
  1085. *-- Calls.......: None
  1086. *-- Called by...: MsWind2()            Function in WINDOWS.PRG
  1087. *-- Usage.......: Do MSWinAt2
  1088. *-- Example.....: Do MSWinAt2
  1089. *-- Returns.....: None
  1090. *-- Parameters..: None
  1091. *-------------------------------------------------------------------------------
  1092.     
  1093.     @1,1 say "This is line 1"
  1094.     @2,1 say "And this is line 2"
  1095.     
  1096. RETURN
  1097. *-- EoP: MSWinAt2
  1098.  
  1099. FUNCTION Alert3
  1100. *-------------------------------------------------------------------------------
  1101. *-- Programmer..: Adam L. Menkes (SUPREME1)
  1102. *-- Date........: 12/23/1992
  1103. *-- Notes.......: This function based on Alert2()
  1104. *--               This routine creates a popup on the screen with a title and
  1105. *--               one line message, forcing the user to notice the message.
  1106. *--               The user must use the mouse on the 'OK' pad, press <Esc> or
  1107. *--               press <Enter> to move on in the program that called this
  1108. *--               function.
  1109. *-- Written for.: dBASE IV, 1.5
  1110. *-- Rev. History: Original: 06/19/1992
  1111. *--               Alert2()
  1112. *--               Modified to accept the <Enter> key by Ken Mayer.
  1113. *--               06/19/1992 -- Copied from Adam's original, uses a window,
  1114. *--                 shadow, and programmer defineable colors.
  1115. *--               07/29/1992 -- Joey stepped in and made some modifications
  1116. *--                 that seem to have helped as well, including dealing with
  1117. *--                 the keyboard buffer.
  1118. *--               10/09/1992 -- minor change -- title is now same color as
  1119. *--                 the "pad".
  1120. *--               Alert22()
  1121. *--               11/12/1992 -- changed to look more like a Win 3.0/3.1
  1122. *--                 window by printing a special 'line' below the title.
  1123. *--                 Also removed hard coding which forced border to DOUBLE
  1124. *--                 so that if called with border set to NONE, gives even more
  1125. *--                 Win-like appearance.  Calls a new function written for this
  1126. *--                 technique, but can be used in other programs.
  1127. *--               11/16/1992 -- modified to add cBORDER parameter ... (K. Mayer)
  1128. *--               12/23/1992 -- tuned up centering of cTitle, cMessage, and
  1129. *--                 [OK] pad.  Eliminated calls to Center.prg by using Justify()
  1130. *--                 along with @ say.        (Joey Carroll)
  1131. *-- Calls.......: SHADOW               Procedure in PROC.PRG
  1132. *--               JUSTIFY()            Function in PROC.PRG
  1133. *--               COLORBRK()           Function in PROC.PRG
  1134. *--               FBCLRBRK()           Function in PROC.PRG 
  1135. *-- Called by...: Any
  1136. *-- Usage.......: Alert2("<cTitle>","<cMessage>","<cColor>"[,"<cBorder>"])
  1137. *-- Example.....: ** if no border, I suggest colors which will contrast
  1138. *--                  with the active screen or window
  1139. *--               lX = Alert2("Print Aborted","You pressed <ESC>",;
  1140. *--                           "rg+/r,w+/b,rg+/r","NONE")
  1141. *-- Returns.....: Logical
  1142. *-- Parameters..: cTitle   = Title line
  1143. *--               cMessage = One line message (up to 75 characters)
  1144. *--               cColor   = Colors: <window forg/back>,<pad> (and title),<box>
  1145. *--               cBorder  = Border type (DOUBLE, SINGLE, NONE, PANEL) -- 
  1146. *--                          optional -- will default to your setting
  1147. *-------------------------------------------------------------------------------
  1148.  
  1149.    parameters cTitle, cMessage, cColor, cBorder
  1150.    private wWindow,mPad,cTempCol,cColorF,cColorB,cColorAll
  1151.    private nWidth,nULRow,nULCol,nLRRow,nLRCol,cTitle2,cMessage2,nBorder
  1152.  
  1153.    cTitle2 = " " + ltrim(trim(cTitle)) + " "      && don't jamb against walls
  1154.    cMessage2 = " " + ltrim(trim(cMessage)) + " "  && don't jamb against walls
  1155.    wWindow = WINDOW()                             && save current Window
  1156.    save screen to sTemp                           && save the screen
  1157.    activate screen
  1158.    cDummykey = inkey()                            && clear out keyboard buffer
  1159.    cOldBorder = set("BORDER")                     && get old border setting
  1160.    if .not. type("CBORDER") = "L"                 && if user set border ...
  1161.       set border to &cBorder                      && start NEW border setting
  1162.    endif
  1163.    nBorder   = iif(set("BORDER") = "NONE",0,2)    && border factor
  1164.    *-- get window coordinates
  1165.    *-- this centers from top to bottom, depending on monitor setup ...
  1166.    nULRow = iif(val(right(set("DISPLAY"),2)) = 43,18,8)
  1167.    *-- add rows, number depends on border, so the Window is large enough ...
  1168.    nBRRow = nULRow + 5 +nBorder
  1169.  
  1170.    *-- left column ...
  1171.    nULCol = 40 - (max(len(cTitle2),len(cMessage2))/2)    && center left-right
  1172.    *-- right column ...
  1173.    nBRCol = nULCol + max(len(cTitle2),len(cMessage2)) + (nBorder - 1)
  1174.    *-- Window width ...
  1175.    nWidth = nBRCol - nULCol - 1
  1176.  
  1177.    *-- define window
  1178.    Define window wAlert from nULRow,nULCol to nBRRow,nBRCol color &cColor.
  1179.  
  1180.    *-- display shadow
  1181.    do shadow with nULRow,nULCol,nBRRow,nBRCol
  1182.  
  1183.    *-- start 'er up ...
  1184.    activate window wAlert
  1185.  
  1186.    *-- display  a new type type line to look more like Win
  1187.    cTempCol = colorbrk(cColor,2)
  1188.    cColorF   = FBClrBrk("B",cTempCol)           && background of title bar text
  1189.    cColorB   = FBClrBrk("B",colorbrk(cColor,1)) && foreground of 'normal' text
  1190.    cColorAll = cColorF + "/" + cColorB          && color of 'special' line
  1191.    @ 0,0 say justify(cTitle2,nWidth + iif(nBorder = 0,4,2),"C") ;
  1192.                color &cTempCol                                && the Title Bar
  1193.    *-- chr(223) looks like this --> ▀ <--
  1194.    @ 1,0 say replicate(chr(223),nWidth + 2) color &cColorAll  && make thicker
  1195.  
  1196.    *-- display message
  1197.    @ 2,0 say justify(cMessage2,nWidth + iif(nBorder = 0,4,2),"C")
  1198.    *-- define/display a very small menu (one pad)
  1199.    define menu mAlert
  1200.    define pad pPad1 of mAlert prompt "[OK]" at 4,((nWidth-nBorder-2)/2)
  1201.    on selection pad pPad1 of mAlert deactivate menu
  1202.  
  1203.    *-- added by Ken to deal with <Enter>
  1204.    on key label ctrl-M keyboard "{27}"
  1205.  
  1206.    *-- start it up
  1207.    activate menu mAlert
  1208.  
  1209.    *-- deal with user 'input'
  1210.    mPad = pad()
  1211.    deactivate window wAlert
  1212.    release window wAlert
  1213.  
  1214.    *-- restore environment, free up RAM by releasing things
  1215.    on key label ctrl-m
  1216.    restore screen from sTemp
  1217.    release screen sTemp
  1218.    release menu mAlert
  1219.    if "" # wWindow
  1220.        activate window &wWindow
  1221.    endif
  1222.     set border to &cOldBorder
  1223.     
  1224. RETURN .not. "" = mPad  && not empty pad?
  1225. *-- EoF: Alert3()
  1226.  
  1227. FUNCTION YesNo3
  1228. *-------------------------------------------------------------------------------
  1229. *-- Programmer..: Kenneth J. Mayer
  1230. *-- Date........: 01/06/1993
  1231. *-- Notes.......: A version of the YESNO() routines in PROC.PRG, that will
  1232. *--               handle a long (up to 254 character) message string, is
  1233. *--               centered on the screen, and has a title bar kind of like
  1234. *--               a Windows dialog box ...
  1235. *-- Written for.: dBASE IV, 1.5
  1236. *-- Rev. History: None
  1237. *-- Calls.......: Center               Procedure in PROC.PRG
  1238. *--               Shadow               Procedure in PROC.PRG
  1239. *--               WordWrap             Procedure in STRINGS.PRG
  1240. *--               ColorBrk()           Function in PROC.PRG
  1241. *--               FBClrBrk()           Function in PROC.PRG
  1242. *--               Justify()            Function in PROC.PRG
  1243. *-- Called by...: Any
  1244. *-- Usage.......: YesNo3(<lDefault>,<cTitle>,<cMessage>,<cColor>)
  1245. *-- Example.....: if YesNo3(.t.,"Test","This is a message of any length"+;
  1246. *--                         "up to 254 characters.",cWind1)
  1247. *-- Returns.....: logical
  1248. *-- Parameters..: lDefault  = Logical value, for the default menu pad (Yes/No)
  1249. *--               cTitle    = Title for title bar -- no longer than 30 
  1250. *--                           characters.
  1251. *--               cMessage  = Message - up to 254 characters in length.
  1252. *--               cColor    = "Standard" colors for window/menu/box
  1253. *-------------------------------------------------------------------------------
  1254.  
  1255.     parameters lDefault, cTitle, cMessage, cColor
  1256.     private nULRow, nULCol, nBRRow, nBRCol, nLMargin, nRMargin, lWrap
  1257.     
  1258.     *-- save it, so we can activate the screen and display a window on top
  1259.     *-- of whatever's there
  1260.     save screen to sYesNo
  1261.     
  1262.     *-- save window if there is one, and activate screen to be safe:
  1263.     wWindow = window()
  1264.     activate screen
  1265.     
  1266.     *-- now to define the coordinates ...
  1267.     nULCol = 20   && left side of box
  1268.     nBRCol = 60   && right side of box
  1269.     
  1270.     nWidth =  36  && width of dialog box ... 36 characters for text
  1271.     nHeight = int(len(cMessage)/nWidth)
  1272.     *-- if the remainder of the length of the message/width of box is > 0
  1273.     *-- we have one more line of text ...
  1274.     nHeight = nHeight + iif(mod(len(cMessage),nWidth)>0,1,0)  
  1275.     
  1276.     *-- deal with room for title, and menu at bottom
  1277.     nHeight = nHeight + 4
  1278.     
  1279.     *-- row coordinates
  1280.     nULRow = (24-nHeight) / 2     && top row
  1281.     nBRRow = nULRow + nHeight + 1
  1282.     
  1283.     *-- define the window
  1284.     define window wYesNo from nULRow,nULCol to nBRRow,nBRCol double color &cColor
  1285.     
  1286.     *-- now for the menu pads
  1287.     define menu mYesNo
  1288.     define pad pYes of mYesNo prompt "[Yes]" at nHeight - 1,10
  1289.     define pad pNo  of mYesNo prompt "[No]"  at nHeight - 1,25
  1290.     on selection pad pYes of mYesNo deactivate menu
  1291.     on selection pad pNo  of mYesNo deactivate menu
  1292.     
  1293.     *-- display it
  1294.     do shadow with nULRow,nULCol,nBRRow,nBRCol
  1295.     activate window wYesNo
  1296.     
  1297.     *-- display title
  1298.     if len(cTitle) < nWidth
  1299.         cTitle = justify(cTitle,39,"C")
  1300.         if len(cTitle) < 39
  1301.             cTitle = cTitle + " "
  1302.         endif
  1303.     endif
  1304.     cTempCol = colorbrk(cColor,2)
  1305.     cColorF  = FBClrBrk("B",cTempCol)
  1306.     cColorB  = FBClrBrk("B",colorbrk(cColor,1))
  1307.     cColorAll = cColorF + "/" + cColorB
  1308.     @0,0 say cTitle color &cTempCol
  1309.     @1,0 say replicate(chr(223),39) color &cColorAll
  1310.     
  1311.     *-- display message
  1312.     do WordWrap with 2,2,cMessage,35
  1313.     
  1314.     *-- set Y/N keys for menu pad
  1315.     clear typeahead && just to be safe
  1316.     on key label Y keyboard iif(pad() = "PYES","",chr(19))+chr(13)
  1317.     on key label N keyboard iif(pad() = "PNO", "",chr(4) )+chr(13)
  1318.     
  1319.     *-- activate the menu
  1320.     if lDefault
  1321.         activate menu mYesNo pad pYes
  1322.     else
  1323.         activate menu mYesNo pad pNo
  1324.     endif
  1325.     
  1326.     *-- reset system
  1327.     on key label Y
  1328.     on key label N
  1329.     deactivate window wYesNo
  1330.     release window wYesNo
  1331.     restore screen from sYesNo
  1332.     release screen sYesNo
  1333.     release menu mYesNo
  1334.     if .not. isblank(wWindow)
  1335.         activate window &wWindow
  1336.     endif
  1337.  
  1338. RETURN iif(pad() = "PYES",.t.,.f.)
  1339. *-- EoF: YesNo3()
  1340.  
  1341. *-------------------------------------------------------------------------------
  1342. *-- These functions are here so that we don't have to go hunting all over
  1343. *-------------------------------------------------------------------------------
  1344.  
  1345. FUNCTION TempName
  1346. *-------------------------------------------------------------------------------
  1347. *-- Programmer..: Martin Leon (HMAN)  Former Sysop, ATBBS
  1348. *-- Date........: 05-27-1992
  1349. *-- Notes.......: Obtain a name for a temporary file of a given extension
  1350. *--               that does not conflict with existing files.
  1351. *-- Written for.: dBASE IV, v1.5
  1352. *-- Rev. History: Originally part of Makestru(), 6-12-1991
  1353. *--               04/26/92, made a separate function - Jay Parsons
  1354. *--               05/27/92, added lDBTMP option - Bowen Moursund
  1355. *-- Calls.......: None
  1356. *-- Called by...: Any
  1357. *-- Usage.......: TempName( cExt , lDBTMP )
  1358. *-- Example.....: Sortfile = TempName( "DBF" , .t. )
  1359. *-- Returns.....: Name not already in use. Additionally, if the memvar
  1360. *--               cDBTMP is declared before calling the function with
  1361. *--               the lDBTMP option, it will be assigned the result
  1362. *--               of getenv("DBTMP").
  1363. *-- Parameters..: cExt   = Extension to be given file ( without the "." )
  1364. *--               lDBTMP = Optional. If .t., function returns unique file
  1365. *--                        name in the DBTMP subdirectory.
  1366. *-- Side Effects: The function will return a unique filename for the DEFAULT
  1367. *--               subdirectory if the lDBTMP option is used and the DOS
  1368. *--               environment variable DBTMP does not point to a valid
  1369. *--               subdirectory.
  1370. *-------------------------------------------------------------------------------
  1371.  
  1372.    parameters cExt, lDBTMP
  1373.    private all except cDBTMP
  1374.    cDefDir = set("DIRECTORY")
  1375.    if lDBTMP
  1376.       cDBTMP = getenv("DBTMP")
  1377.       if "" # cDBTMP
  1378.          set directory to &cDBTMP.
  1379.       endif
  1380.    endif
  1381.    do while .t.
  1382.       Fname = "TMP" + ltrim( str( rand() * 100000, 5 ) )
  1383.       if .not. file( Fname + "." + cExt ) .and. ( upper( cExt ) # "DBF" .or.;
  1384.          .not. ( file( Fname + ".MDX" ) .or. file ( Fname + ".DBT" ) ) )
  1385.             exit
  1386.       endif
  1387.    enddo
  1388.    set directory to &cDefDir.
  1389.  
  1390. RETURN Fname
  1391. *-- Eof() TempName
  1392.  
  1393. FUNCTION ArrayRows
  1394. *-------------------------------------------------------------------------------
  1395. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1396. *-- Date........: 03/01/1992
  1397. *-- Notes.......: Number of Rows in an array
  1398. *-- Written for.: dBASE IV, 1.1
  1399. *-- Rev. History: None
  1400. *-- Calls.......: None
  1401. *-- Called by...: Any
  1402. *-- Usage.......: ArrayRows("<aArray>")
  1403. *-- Example.....: n = ArrayRows("aTest")
  1404. *-- Returns.....: numeric
  1405. *-- Parameters..: aArray      = Name of array 
  1406. *-------------------------------------------------------------------------------
  1407.  
  1408.     parameters aArray
  1409.     private nHi, nLo, nTrial, nDims
  1410.     nLo = 1
  1411.     nHi = 1170
  1412.     if type( "&aArray[ 1, 1 ]" ) = "U"
  1413.       nDims = 1
  1414.     else
  1415.      nDims = 2
  1416.     endif
  1417.     do while .T.
  1418.      nTrial = int( ( nHi + nLo ) / 2 )
  1419.       if nHi < nLo
  1420.         exit
  1421.       endif
  1422.      if nDims = 1 .and. type( "&aArray[ nTrial ]" ) = "U" .or. ;
  1423.        nDims = 2 .and. type( "&aArray[ nTrial, 1 ]" ) = "U"
  1424.         nHi = nTrial - 1
  1425.       else
  1426.         nLo = nTrial + 1
  1427.       endif
  1428.     enddo
  1429.     
  1430. RETURN nTrial
  1431. *-- EoF: ArrayRows()
  1432.  
  1433. FUNCTION ArrayCols
  1434. *-------------------------------------------------------------------------------
  1435. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1436. *-- Date........: 03/01/1992
  1437. *-- Notes.......: Number of Columns in an array
  1438. *-- Written for.: dBASE IV, 1.1
  1439. *-- Rev. History: None
  1440. *-- Calls.......: None
  1441. *-- Called by...: Any
  1442. *-- Usage.......: ArrayCols("<aArray>")
  1443. *-- Example.....: n = ArrayCols("aTest")
  1444. *-- Returns.....: numeric
  1445. *-- Parameters..: aArray      = Name of array 
  1446. *-------------------------------------------------------------------------------
  1447.  
  1448.     parameters aArray
  1449.    private nHi, nLo, nTrial
  1450.     nLo = 1
  1451.     nHi = 1170
  1452.     if type( "&aArray[ 1, 1 ]" ) = "U"
  1453.       RETURN 0
  1454.     endif
  1455.     do while .t.
  1456.       nTrial = int( ( nHi + nLo ) / 2 )
  1457.       if nHi < nLo
  1458.          exit
  1459.       endif
  1460.       if type( "&aArray[ 1, nTrial ]" ) = "U"
  1461.         nHi = nTrial - 1
  1462.       else
  1463.         nLo = nTrial + 1
  1464.       endif
  1465.     enddo
  1466.  
  1467. RETURN nTrial
  1468. *-- EoF: ArrayCol()
  1469.  
  1470. FUNCTION FieldNum
  1471. *-------------------------------------------------------------------------------
  1472. *-- Programmer..: ?
  1473. *-- Date........: 03/09/1992
  1474. *-- Notes.......: Designed to return the number of a given fieldname in the
  1475. *--               database structure. Works on open database only ...
  1476. *-- Written for.: dBASE IV, 1.5
  1477. *-- Rev. History: 06/01/1992 -- Adam L. Menkes for 1.5 ...
  1478. *-- Calls.......: None
  1479. *-- Called by...: Any
  1480. *-- Usage.......: FieldNum("<cFldName>")
  1481. *-- Example.....: n = FieldNum("Firstname")
  1482. *-- Returns.....: Numeric
  1483. *-- Parameters..: cFldName = Name of Field 
  1484. *-------------------------------------------------------------------------------
  1485.  
  1486.     Parameters cFldName
  1487.     cExact = set("EXACT")
  1488.     set exact on
  1489.     nField = 1
  1490.     do while upper(cFldName) <> FIELD(nField) .and. nField <= fldcount()
  1491.         nField = nField + 1
  1492.     enddo
  1493.     set exact &cExact
  1494.  
  1495. RETURN iif(len(trim(field(nField))) = 0,0,nField)
  1496. *-- EoF: FieldNum()
  1497.  
  1498. FUNCTION Justify
  1499. *-------------------------------------------------------------------------------
  1500. *-- Programmer..: Roland Bouchereau (Ashton-Tate)
  1501. *-- Date........: 12/23/1992
  1502. *-- Notes.......: Used to pad a field/string on the right, left or both,
  1503. *--               justifying or centering it within the length specified.
  1504. *--               If the length of the string passed is greater than
  1505. *--               the size needed, the function will truncate it. 
  1506. *--               Taken from Technotes, June 1990. Defaults to Left Justify
  1507. *--               if invalid TYPE is passed ...
  1508. *-- Written for.: dBASE IV, 1.0
  1509. *-- Rev. History: Original function 06/15/1991
  1510. *--               12/17/1991 -- Modified into ONE function from three by
  1511. *--                  Ken Mayer, added a third parameter to handle that.
  1512. *--               12/23/1992 -- Modified by Joey Carroll to use STUFF()
  1513. *--                  instead of TRANSFORM().
  1514. *-- Calls.......: None
  1515. *-- Called by...: Any
  1516. *-- Usage.......: Justify(<cFld>,<nLength>,"<cType>")
  1517. *-- Example.....: ?? Justify(Address,25,"R")
  1518. *-- Returns.....: Padded/truncated field
  1519. *-- Parameters..: cFld    =  Field/Memvar/Character String to justify
  1520. *--               nLength =  Width to justify within
  1521. *--               cType   =  Type of justification: L=Left, C=Center,R=Right
  1522. *-------------------------------------------------------------------------------
  1523.     
  1524.     parameters cFld,nLength,cType
  1525.     private cReturn
  1526.     
  1527.     cType = upper(cType)    && just making sure ...
  1528.     if type("cFld")+type("nLength")+type("cType") $ "CNC,CFC"
  1529.        *-- set a picture function of 'X's, with @I,@J or @B function
  1530.        cReturn = space(nLength)
  1531.         cReturn = stuff(cReturn,;
  1532.                         iif(cType = "C",(nLength-len(cFld))/2,;
  1533.                         iif(cType = "R",nLength-len(cFld)+1,1)),;
  1534.                         len(cFld),cFld)
  1535.     else
  1536.         cReturn = ""
  1537.     endif
  1538.  
  1539. RETURN cReturn
  1540. *-- EoF: Justify()
  1541.  
  1542. PROCEDURE WordWrap
  1543. *-------------------------------------------------------------------------------
  1544. *-- Programmer..: David Frankenbach (CIS: 72147,2635)
  1545. *-- Date........: 01/14/1993 (Version 1.1)
  1546. *-- Notes.......: Wraps a long string, breaking it into strings that have
  1547. *--               a maximum length of nWidth. The first output is displayed
  1548. *--               @nRow, nCol. Words are not split ...
  1549. *-- Written for.: dBASE IV, 1.5
  1550. *-- Rev. History: 01/06/1993 -- Original Release (Version 1.0)
  1551. *--               01/14/1993 -- Version 1.1 -- Corrected side-effect of 
  1552. *--                       destroying string arg, added test for 
  1553. *--                       string[nWidth+1] = " "
  1554. *-- Calls.......: None
  1555. *-- Called by...: Any
  1556. *-- Usage.......: do WordWrap with <nRow>, <nCol>, <cString>, <nWidth>
  1557. *-- Example.....: do WordWrap with 2,2,cText,38
  1558. *-- Returns.....: None
  1559. *-- Parameters..: nRow     = Row to display first line at
  1560. *--               nCol     = Left side of area to display text at
  1561. *--               cString  = text to wrap
  1562. *--               nWidth   = Width of area to wrap text in
  1563. *-------------------------------------------------------------------------------
  1564.  
  1565.     parameters nRow, nCol, cString, nWidth
  1566.     private cTemp, nI, cStr
  1567.     
  1568.     cStr = cString                  && work with a COPY of input, to avoid
  1569.                                     && destroying original
  1570.     
  1571.     do while len(cStr) > 0          && while there's something to work on
  1572.         if (nWidth < len(cStr))
  1573.             nI = nWidth               && look for last " " in first nWidth
  1574.             
  1575.             if substr(cStr,nI+1,1) # " "
  1576.                 do while ( (nI > 0) .and. (substr(cStr,nI,1) # " ") )
  1577.                     nI = nI - 1
  1578.                 enddo
  1579.             endif
  1580.             
  1581.             if nI = 0                 && no spaces
  1582.                 nI = nWidth            && get first nWidth characters
  1583.             endif
  1584.         else
  1585.             nI = len(cStr)         && use the rest of the string
  1586.         endif
  1587.         
  1588.         cTemp = left(cStr,nI)     && get the part we're going to display
  1589.         
  1590.         if nI < len(cStr)         && remove that part
  1591.            cStr = ltrim(substr(cStr,nI + 1))
  1592.         else
  1593.             cStr = ""
  1594.         endif
  1595.         
  1596.         *-- display it
  1597.         @nRow,nCol say cTemp
  1598.         *-- move to next row
  1599.         nRow = nRow + 1
  1600.         
  1601.     enddo
  1602.     
  1603. RETURN
  1604. *-- EoP: WordWrap
  1605.  
  1606. *-------------------------------------------------------------------------------
  1607. *-- End of Program: WINDOWS.PRG
  1608. *-------------------------------------------------------------------------------
  1609.